home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Nordlicht Spiele / Nordlicht Spiele 01-02 (19xx)(Nordlicht)(DE)(PD).zip / Nordlicht Spiele 01-02 (19xx)(Nordlicht)(DE)(PD).adf / blue_title (.txt) < prev    next >
AmigaBASIC Source Code  |  1989-07-18  |  5KB  |  89 lines
  1. ON BREAK GOSUB marke:BREAK ON:ON ERROR GOTO marke2:FOR t=1 TO 10:MENU t,0,0,"":NEXT t
  2. DECLARE FUNCTION xopen& LIBRARY:DECLARE FUNCTION xread& LIBRARY
  3. DECLARE FUNCTION move& LIBRARY:DECLARE FUNCTION allocmem& LIBRARY
  4. DECLARE FUNCTION AllocRemember& LIBRARY:DECLARE FUNCTION opendiskfont& LIBRARY
  5. LIBRARY "dos.library":LIBRARY "graphics.library":LIBRARY "intuition.library"
  6. LIBRARY "exec.library":LIBRARY "diskfont.library"
  7. SUB xy (x%,y%) STATIC
  8. e&=move&(WINDOW(8),x%,y%)
  9. END SUB
  10. SUB diskfont(font$,height%) STATIC
  11. SHARED strfont&:prefs%=96:font0$=font$+".font"+CHR$(0)
  12. IF strfont&<>0 THEN CALL closefont(strfont&)
  13. textattr&(0)=SADD(font0$):textattr&(1)=height%*2^16+prefs%:strfont&=opendiskfont&(VARPTR(textattr&(0)))
  14. IF strfont&<>0 THEN CALL setfont (WINDOW(8),strfont&)
  15. END SUB
  16. SUB t(t%) STATIC
  17. a=TIMER
  18. t:IF TIMER<a+t% THEN GOTO t
  19. END SUB
  20. SUB at(t%) STATIC
  21. a=TIMER
  22. at:IF TIMER<a+t% AND MOUSE(0)=0 THEN GOTO at
  23. END SUB
  24. SUB pic(daten$) STATIC
  25. DIM planes&(5):laenge&=(320*200)/8:farben&=2^5:daten$=daten$+CHR$(0):CLS:FOR t=0 TO 31:PALETTE t,0,0,0:NEXT t
  26. rastport=WINDOW(8):bitmap=PEEKL(rastport+4):FOR t=1 TO 5:planes&(t)=PEEKL(bitmap+4+4*t):NEXT t
  27. windowx&=WINDOW(7):screenx&=PEEKL(windowx+46):viewport&=screenx&+44:handle&=xopen&(SADD(daten$),1005)
  28. FOR t=1 TO 5:erg&=xread&(handle&,planes&(t),laenge&):NEXT t:CALL xclose(handle&):ERASE planes&
  29. END SUB
  30. title:DATA 0,0,0,0,0,0,3,3,3,5,5,5,8,8,8,10,10,10,12,12,12,15,15,15,9,13,15
  31. DATA 6,10,14,4,8,12,2,5,11,9,14,14,8,7,8,6,9,14,15,0,0,15,4,0,15,7,0
  32. DATA 15,11,0,15,15,0,15,0,15,15,4,15,15,8,15,15,11,15,15,15,15,0,15,0
  33. DATA 0,13,0,0,10,0,0,8,0,0,0,0,0,0,0,0,0,0
  34. table:DATA 0,0,0,0,0,0,3,3,3,5,5,5,8,8,8,10,10,10,12,12,12,15,15,15,2,11,2
  35. DATA 2,10,2,6,14,6,15,12,5,4,5,15,7,10,15,15,0,0,15,5,0,15,10,0,15,15,0
  36. DATA 15,8,15,15,0,15,9,13,15,5,8,14,3,6,12,2,5,11,10,0,10,15,0,15,15,4,15
  37. DATA 15,8,15,15,11,15,15,15,15,0,0,0,0,0,0
  38. hi:DATA 0,0,0,0,0,0,3,3,3,5,5,5,6,6,6,8,8,8,10,10,10,12,11,11,13,13,13,15,15,15
  39. DATA 0,0,15,0,3,15,0,6,15,0,9,15,0,12,15,0,15,15,15,15,15,10,10,15,5,5,15
  40. DATA 0,0,15,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  41. scores:DATA 0,0,0,0,0,0,3,3,3,5,5,5,6,6,6,8,8,8,10,10,10,12,11,11,13,13,13,15,15,15
  42. DATA 0,0,15,0,3,15,0,6,15,0,9,15,0,12,15,0,15,15,4,15,15,8,15,15,11,15,15,15,15,15
  43. DATA 15,13,15,15,11,15,15,9,15,15,6,15,15,4,15,15,2,15,15,2,12,15,1,8,15,1,4,15,0,0,0,0,0,0,0,0
  44. SUB col STATIC
  45. FOR t=0 TO 31:READ r,g,b:PALETTE t,r/15,g/15,b/15:NEXT t
  46. END SUB
  47. wscr&=PEEKL(WINDOW(7)+46):CALL movescreen&(wscr&,0,300)
  48. SCREEN 1,320,200,5,1:WINDOW 1,"",,0,1:scr1&=PEEKL(WINDOW(7)+46):FOR t=0 TO 31:PALETTE t,0,0,0:NEXT t
  49. SCREEN 2,320,200,5,1:WINDOW 2,"",,0,2:scr2&=PEEKL(WINDOW(7)+46):FOR t=0 TO 31:PALETTE t,0,0,0:NEXT t
  50. hardware&=14675968:speed=425:f$=":snd_1"+CHR$(0)
  51. OPEN "I",#1,f$:laenge&=LOF(1):CLOSE #1:adresse&=allocmem&(laenge&,2)
  52. handle&=xopen&(SADD(f$),1005):erg&=xread&(handle&,adresse&,laenge&)
  53. CALL xclose(handle&):WINDOW 1:CALL screentofront&(scr2&)
  54. CALL pic (":title_pic"):RESTORE title:CALL col:WINDOW 2:WHILE MOUSE(0)<>0:WEND:spieler=0
  55. POKEL hardware&+160,adresse&:POKEW hardware&+164,INT(laenge&/2)
  56. POKEW hardware&+166,speed:POKEW hardware&+168,64:POKEW hardware&+150,32769
  57. vorspann:CALL screentofront&(scr1&):hardware&=14675968
  58. CALL pic (":table_pic"):at(12):RESTORE table:CALL col
  59. WINDOW 1:FOR t=0 TO 320:LINE (150,100)-(t,0),0:NEXT t:FOR t=0 TO 220:LINE (150,100)-(320,t),0:NEXT t
  60. FOR t=320 TO 0 STEP -1:LINE (150,100)-(t,220),0:NEXT t
  61. FOR t=220 TO 0 STEP -1:LINE (150,100)-(0,t),0:NEXT t:IF MOUSE(0)<>0 THEN GOTO spielstart
  62. CALL screentofront&(scr2&):CALL pic(":hi_pic"):at(12):RESTORE hi: CALL col:WINDOW 2
  63. FOR t=0 TO 200 STEP 2:LINE (0,10+t)-(320,10+t),0:LINE (0,197-t)-(320,197-t),0:NEXT t
  64. IF MOUSE(0)<>0 THEN GOTO spielstart
  65. CALL screentofront&(scr1&):CALL pic("scores_pic")
  66. CALL setdrmd&(WINDOW(8),0):diskfont "mini",6:OPEN ":scor" FOR INPUT AS 1
  67. FOR t=1 TO 9:COLOR 9+t,0:INPUT#1,n$:INPUT#1,p:LOCATE 7+t,24+3:PRINT t:LOCATE 7+t,26+3
  68. PRINT ".":LOCATE 7+t,28+3:PRINT n$:LOCATE 7+t,44+3:PRINT p:NEXT t
  69. FOR t=10 TO 20:COLOR 9+t,0:INPUT#1,n$:INPUT#1,p:LOCATE 7+t,23+3:PRINT t:LOCATE 7+t,26+3
  70. PRINT ".":LOCATE 7+t,28+3:PRINT n$:LOCATE 7+t,44+3:PRINT p
  71. NEXT t:CALL setdrmd&(WINDOW(8),1):CLOSE 1:RESTORE scores:CALL col:WINDOW 1
  72. FOR t=0 TO 300:CALL movescreen(scr1&,0,1):NEXT t:CLS:FOR t=0 TO 31:PALETTE t,0,0,0:NEXT t
  73. CALL screentofront&(scr2&):CALL movescreen(scr1&,0,-500):IF MOUSE(0)<>0 THEN GOTO spielstart
  74. at(14):CALL pic (":title_pic"):RESTORE title:CALL col:WINDOW 2
  75. u=0:o=0:FOR u=0 TO 20:LINE (0,0)-(u,200),0:NEXT u
  76. again:FOR t=0 TO 40:LINE (o+t,0)-(u,200),0:NEXT t
  77. o=o+t:FOR t=0 TO 40:LINE (o,0)-(u+t,200),0:NEXT t
  78. u=u+t:IF u<320 AND o<320 THEN GOTO again
  79. IF MOUSE(0)<>0 THEN GOTO spielstart
  80. GOTO vorspann
  81. spielstart:
  82. FOR t=64 TO 0 STEP -1:POKEW hardware&+168,t:FOR tt=0 TO 150:NEXT tt:NEXT t
  83. POKEW hardware&+150,1:CALL freemem(adresse&,laenge&)
  84. LIBRARY CLOSE:WINDOW 1:CLS:WINDOW 2:CLS
  85. CHAIN "blue"
  86. marke:RETURN
  87. marke2:RESUME NEXT
  88.  
  89.